home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 095 / rfix0620.arc / RSB30620.MRG < prev    next >
Encoding:
Text File  |  1988-06-20  |  9.7 KB  |  237 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against I:\161A.REL\RBBSSUB3.BAS to produce RBBSSUB3.BAS
  3. * I:\161A.REL\RBBSSUB3.BAS:  Date 3-25-1988  Size 173696 bytes
  4. * ------------[ Created 06-20-1988 22:26:51 ]------------
  5. * REPLACING old line(s) by new
  6. * ------[ first line different ]------
  7. 58902 FILE.NAME$ = DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + _           ' TF042001
  8.                     "." + DIRECTORY.EXTENTION$                       ' TF042001
  9.       GDEFAULT$ = MID$(" GC",GR + 1, 1)                              ' TF042001
  10.       CALL GRAPHIC (GDEFAULT$)                                       ' TF042001
  11.       CALL BUFFILE (FILE.NAME$)                                      ' TF042001
  12.       GOTO 58900
  13.       END SUB
  14. '
  15. ' $SUBTITLE: 'CONVDIRS -- Converts coded response to right directory'
  16. ' $PAGE
  17. '
  18. '  SUBROUTINE NAME    -- CONVDIRS
  19. '
  20. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  21. '                            STRT               ELEMENT TO BEGIN WITH
  22. '                            B$                 ARRAY TO CONVERT
  23. '                            Q                  LAST ELEMENT TO CONFERT
  24. '
  25. '   OUTPUT PARAMETERS --     B$                 CONVERTED DIRECTORY LIST
  26. '
  27. '  SUBROUTINE PURPOSE -- LET THE USER PUT IN A SHORT STANDARD STRING FOR A
  28. '                        DIRECTORY
  29. '
  30. '
  31. * REPLACING old line(s) by new
  32. 59530 Z$ = B$(ANS.INDEX)
  33.       CALL ALLCAPS (Z$)
  34.       IF INSTR(RETURN.ON$,Z$) THEN _  'check whether calling pgm wants
  35.          EXIT SUB
  36.       IF INSTR("LH?",Z$) THEN _       'check whether caller wants help
  37.          GOTO 59515
  38.       IF INSTR(Z$,".") > 0 THEN _
  39.          GOTO 59545
  40.       FILE.NAME$ = FRONT.OPT$ + _
  41.                    Z$
  42.       CALL BADFILE (FILE.NAME$,A)
  43.       IF A > 1 THEN _
  44.          GOTO 59547
  45.       FILE.NAME$ = FILE.NAME$ + _
  46.                    BACK.OPT$
  47. * ------[ first line different ]------
  48.       CALL GRAPHIC (GR.DEFAULT$)                                     ' TF041202
  49.       IF OK THEN _
  50.          IF NOT REQUIRE.IN.MENU THEN _
  51.             EXIT SUB _
  52.          ELSE CALL WORDINFILE (CURRENT.MENU$,Z$,FOUND) : _
  53.               IF FOUND THEN _
  54.                  EXIT SUB _
  55.               ELSE GOTO 59540
  56.       IF NOT VERIFY.IN.MENU THEN _
  57.          GOTO 59540
  58.       CALL WORDINFILE (CURRENT.MENU$,Z$,FOUND)  'verify against menu itself
  59.       IF FOUND THEN _
  60.          IF ALL.MENU.OK THEN _
  61.             EXIT SUB
  62. * REPLACING old line(s) by new
  63. 59790 SUB FINDFILE (FILNAME$,FEXISTS) STATIC
  64.       CALL RBBSFIND (FILNAME$,Z,Y,M,D)
  65.       FEXISTS = (Z = 0)
  66.       END SUB
  67. ' $SUBTITLE: 'ASKMORE -- subroutine to pause when possible screen full'
  68. ' $PAGE
  69. '
  70. '  SUBROUTINE NAME    -- ASKMORE
  71. '
  72. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  73. '                          EXTRA.PRMPT$  STRING TO ADD TO MORE PROMPT AT END
  74. '
  75. '  OUTPUT PARAMETERS  --   B$()
  76. '                          NO
  77. '
  78. '  SUBROUTINE PURPOSE -- DETERMINES WHETHER NEED TO PAUSE IF SCREEN FULL.
  79. '                        AND, IF SO, ASKS THE APPROPRIATE QUESTION.  IF NON-
  80. '                        STOP, AT LEAST CHECK FOR CARRIER PRESENT.
  81. '
  82.       SUB ASKMORE (EXTRA.PRMPT$) STATIC
  83.       IF LINES.PRINTED < PAGE.LENGTH THEN _
  84.          Q = 0 : _
  85.          EXIT SUB
  86.       IF NON.STOP THEN _
  87.          LINES.PRINTED = 0 : _
  88.          CALL CARRIER : _
  89.          EXIT SUB
  90.       CALL CHKTREMAIN (TIME.REMAINING!)
  91.       CALL FINDTIME (AUTO.LOGOFF!)
  92.       AUTO.LOGOFF! = AUTO.LOGOFF! + WAIT.BEFORE.DISCONNECT
  93.       IF EXPERT.USER THEN _
  94.          A$ = "More [Y],N,NS" + _
  95.               EXTRA.PRMPT$ _
  96.       ELSE A$ = "MORE: [Y]es, N)o, NS)non-stop" + _
  97.                 EXTRA.PRMPT$
  98.       NO.ADVANCE = TRUE
  99.       SUBROUTINE.PARAMETER = 1
  100.       CALL TGET
  101.       CALL WIPELINE (33 + LEN(EXTRA.PRMPT$))
  102.       END SUB
  103. ' $SUBTITLE: 'COMPDATE -- subroutine to compute elased days'
  104. ' $PAGE
  105. '
  106. '  SUBROUTINE NAME    -- COMPDATE
  107. '
  108. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  109. '                            YY        YEAR
  110. '                            MM        MONTH
  111. '                            DD        DAY
  112. '                           RESULT!    LOCATION TO PLACE THE RESULT
  113. '
  114. '  OUTPUT PARAMETERS  -- RESULT!       COMPUTE COMPUTATIONAL DATE
  115. '
  116. '  SUBROUTINE PURPOSE -- COMPUTES A COMPUTATIONAL DATE FROM YEAR, MONTH, DAY.
  117. '                        RESULTS MAY BE USED TO COMPUTE THE NUMBER OF ELASPED
  118. '                        DAYS BETWEEN TWO DATES.  YOU MAY PASS A 2 OR 4 DIGIT
  119. '                        YEAR, BUT FOR MEANINGFUL RESULTS, BE CONSISTENT
  120. '
  121.       SUB COMPDATE (YY,MM,DD,RESULT!) STATIC
  122. * ------[ first line different ]------
  123.       IF MM < 1 OR _                                                 ' TF042301
  124.          MM > 12 THEN _                                              ' TF042301
  125.          MM = 1                                                      ' TF042301
  126.       RESULT! = YY * 365.0 + _
  127.                 INT((YY - 1) / 4) + _
  128.                 (MM - 1) * 28 + _
  129.                 VAL(MID$("000303060811131619212426",(MM - 1) * 2 + 1,2)) - _
  130.                 ((MM > 2) AND ((YY MOD 4) = 0)) + _
  131.                 DD
  132.       END SUB
  133. ' $SUBTITLE: 'EXPDATE -- subroutine to display expiration date'
  134. ' $PAGE
  135. '
  136. '  SUBROUTINE NAME    -- EXPDATE
  137. '
  138. '  INPUT PARAMETERS   --   PARAMETER           MEANING
  139. '                        REGISTRATION.DATE!    COMPUTATIONAL REGISTRATION DATE
  140. '                        REGISTRATION.PERIOD   DAYS IN REGISTRATION PERIOD
  141. '
  142. '  OUTPUT PARAMETERS  -- EXP.DATE$             DISPLAYABLE EXPIRATION DATE
  143. '
  144. '  SUBROUTINE PURPOSE -- COMPUTES/CREATES A DISPALYABLE REGISTRATION
  145. '                        EXPIRATION DATE USING REGISTRATION DATE AND DAYS IN
  146. '                        REGISTRATION PERIOD.
  147. '
  148.       SUB EXPDATE (REGISTRATION.DATE!,REGISTRATION.PERIOD,EXP.DATE$) STATIC
  149.       EXPIRE.DATE! = REGISTRATION.DATE! + REGISTRATION.PERIOD
  150.       EXPIRE.YEAR! = INT((EXPIRE.DATE! - EXPIRE.DATE! / 1461) / 365)
  151.       EXPIRE.DAY% = EXPIRE.DATE! - (EXPIRE.YEAR! * 365 + INT((EXPIRE.YEAR! -1)/4))
  152.       EXPIRE.MONTH% = -((EXPIRE.YEAR! MOD 4)<>0) * _
  153.                       (1 - (EXPIRE.DAY% > 31) - (EXPIRE.DAY% > 59) - _
  154.                       (EXPIRE.DAY% > 90) - (EXPIRE.DAY% >120) - _
  155.                       (EXPIRE.DAY% > 151) - (EXPIRE.DAY% > 181) - _
  156.                       (EXPIRE.DAY% > 212) - (EXPIRE.DAY% > 243) - _
  157.                       (EXPIRE.DAY% > 273) - (EXPIRE.DAY% > 304) - _
  158.                       (EXPIRE.DAY% > 334)) - ((EXPIRE.YEAR! MOD 4) = 0) * _
  159.                       (1 - (EXPIRE.DAY% > 31) - (EXPIRE.DAY% > 60) - _
  160.                       (EXPIRE.DAY% > 91) - (EXPIRE.DAY% >121) - _
  161.                       (EXPIRE.DAY% > 152) - (EXPIRE.DAY% > 182) - _
  162.                       (EXPIRE.DAY% > 213) - (EXPIRE.DAY% > 243) - _
  163.                       (EXPIRE.DAY% > 274) - (EXPIRE.DAY% > 305) - _
  164.                       (EXPIRE.DAY% > 335))
  165.       EXPIRE.DAY% = (EXPIRE.DAY% - ((EXPIRE.MONTH% - 1) * 28 + _
  166.         VAL(MID$("000303060811131619212426",(EXPIRE.MONTH% -1) * 2 + 1,2)))) + _ ' TF042403
  167.                     ((EXPIRE.MONTH% > 2) AND _
  168.                     ((EXPIRE.YEAR! MOD 4) = 0))
  169.       EXP.DATE$ = RIGHT$("0" + MID$(STR$(EXPIRE.MONTH%),2),2) + _
  170.                   "/" + _
  171.                   RIGHT$("0" + MID$(STR$(EXPIRE.DAY%),2),2) + _
  172.                   "/" + _
  173.                   RIGHT$(STR$(EXPIRE.YEAR!),2)
  174.       END SUB
  175. ' $SUBTITLE: 'PUTMATTR - subroutine to save msg. attributes'
  176. ' $PAGE
  177. '
  178. '  SUBROUTINE NAME    --  PUTMATTR
  179. '
  180. '  INPUT PARAMETERS   --  PARAMETER                   MEANING
  181. '                         Q
  182. '                         B$
  183. '                         LINES.IN.MESSAGE
  184. '                         S
  185. '                         NON.STOP
  186. '                         MESSAGE.DIM.INDEX
  187. '
  188. '  OUTPUT PARAMETERS  --  SQ
  189. '                         LG$(10)
  190. '                         LINES.IN.MESSAGE.SAVE
  191. '                         SL
  192. '                         NON.STOP.SAVE
  193. '                         MESSAGE.DIM.INDEX.SAVE
  194. '
  195. '  SUBROUTINE PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
  196. '                         THE ATTRIBUTES OF THE ORGINAL MESSAGE
  197. '
  198. * REPLACING old line(s) by new
  199. 64113 IF LEFT$(A$(SCRIPT.INDEX),1) = "?" THEN _         ' QUESTION
  200.          A$ = MID$(A$(SCRIPT.INDEX),2) : _
  201.          SUBROUTINE.PARAMETER = 1 : _
  202.          CALL TGET : _
  203.          IF SUBROUTINE.PARAMETER = -1 THEN _
  204.             GOTO 64510 _
  205.          ELSE IF Q = 0 THEN _
  206.                  GOTO 64113 _
  207.               ELSE A$(SCRIPT.INDEX + 1) = "!" + _
  208.                                           B$ : _
  209.                    GOTO 64110
  210.       IF LEFT$(A$(SCRIPT.INDEX),2) = "=#" THEN _                     ' NUMERIC
  211.          GOSUB 64350 : _
  212.          GOTO 64110
  213.       IF LEFT$(A$(SCRIPT.INDEX),1) = "=" THEN _         ' DECISION
  214.          GOSUB 64300 : _
  215.          IF SUBROUTINE.PARAMETER = -1 THEN _
  216.             GOTO 64510 _
  217.          ELSE GOTO 64110
  218.       IF LEFT$(A$(SCRIPT.INDEX),1) = "-" THEN _         ' LOWER
  219.          ADJUSTED.SECURITY = -1 : _
  220.          USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  221.                                VAL(MID$(A$(SCRIPT.INDEX),2,5)) : _
  222.          GOTO 64110
  223.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _         ' RAISE
  224.          IF USER.SECURITY.LEVEL + VAL(MID$(A$(SCRIPT.INDEX),2,5)) _
  225.             <= MAXIMUM.SECURITY.LEVEL THEN _
  226.                ADJUSTED.SECURITY = -1 : _
  227.                USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  228.                                VAL(MID$(A$(SCRIPT.INDEX),2,5))
  229.       IF LEFT$(A$(SCRIPT.INDEX),1) = "+" THEN _
  230.          GOTO 64110
  231. * ------[ first line different ]------
  232.       A$ = "Invalid line.  Column 1 is <" + LEFT$(A$(SCRIPT.INDEX),1)+">.  Must be: * ? = + - > @" ' TF062001
  233.       SUBROUTINE.PARAMETER = 5
  234.       CALL TPUT
  235.       IF SUBROUTINE.PARAMETER = -1 THEN _
  236.          GOTO 64510
  237.